home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / amulti1a / chatnets.frm < prev    next >
Text File  |  1999-08-26  |  8KB  |  286 lines
  1. VERSION 5.00
  2. Object = "{FFACF7F3-B868-11CE-84A8-08005A9B23BD}#1.7#0"; "DSSOCK32.OCX"
  3. Begin VB.Form chatnetServer 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   " Server"
  6.    ClientHeight    =   2250
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   5985
  10.    Icon            =   "chatnetServer.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2250
  15.    ScaleWidth      =   5985
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin VB.Timer Timer2 
  18.       Left            =   2880
  19.       Top             =   480
  20.    End
  21.    Begin VB.Timer Timer1 
  22.       Enabled         =   0   'False
  23.       Interval        =   60000
  24.       Left            =   3000
  25.       Top             =   48000
  26.    End
  27.    Begin VB.ListBox List1 
  28.       Height          =   2040
  29.       Left            =   4200
  30.       TabIndex        =   6
  31.       Top             =   120
  32.       Width           =   1695
  33.    End
  34.    Begin dsSocketLib.dsSocket dsSocket1 
  35.       Height          =   420
  36.       Index           =   0
  37.       Left            =   2280
  38.       TabIndex        =   5
  39.       Top             =   480
  40.       Width           =   420
  41.       _Version        =   65543
  42.       _ExtentX        =   741
  43.       _ExtentY        =   741
  44.       _StockProps     =   64
  45.       LocalPort       =   2000
  46.       RemoteHost      =   ""
  47.       RemotePort      =   0
  48.       ServiceName     =   ""
  49.       RemoteDotAddr   =   ""
  50.       Linger          =   -1  'True
  51.       Timeout         =   10
  52.       LineMode        =   0   'False
  53.       EOLChar         =   10
  54.       BindConnect     =   0   'False
  55.       SocketType      =   0
  56.    End
  57.    Begin VB.CommandButton Command1 
  58.       Caption         =   "Serve"
  59.       Height          =   315
  60.       Left            =   3120
  61.       TabIndex        =   4
  62.       Top             =   120
  63.       Width           =   975
  64.    End
  65.    Begin VB.TextBox Text1 
  66.       Height          =   1335
  67.       Left            =   120
  68.       MultiLine       =   -1  'True
  69.       ScrollBars      =   2  'Vertical
  70.       TabIndex        =   3
  71.       Top             =   840
  72.       Width           =   3975
  73.    End
  74.    Begin VB.TextBox Text2 
  75.       Height          =   285
  76.       Left            =   1440
  77.       TabIndex        =   1
  78.       Text            =   "127.0.0.1"
  79.       Top             =   120
  80.       Width           =   1575
  81.    End
  82.    Begin VB.Label Label3 
  83.       Caption         =   "0"
  84.       Height          =   15
  85.       Left            =   3600
  86.       TabIndex        =   7
  87.       Top             =   6000
  88.       Width           =   135
  89.    End
  90.    Begin VB.Label Label2 
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "Status:"
  93.       BeginProperty Font 
  94.          Name            =   "MS Sans Serif"
  95.          Size            =   12
  96.          Charset         =   0
  97.          Weight          =   700
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       Height          =   255
  103.       Left            =   120
  104.       TabIndex        =   2
  105.       Top             =   480
  106.       Width           =   975
  107.    End
  108.    Begin VB.Label Label1 
  109.       BackStyle       =   0  'Transparent
  110.       Caption         =   "Your IP Address:"
  111.       Height          =   255
  112.       Left            =   120
  113.       TabIndex        =   0
  114.       Top             =   120
  115.       Width           =   1335
  116.    End
  117. End
  118. Attribute VB_Name = "chatnetServer"
  119. Attribute VB_GlobalNameSpace = False
  120. Attribute VB_Creatable = False
  121. Attribute VB_PredeclaredId = True
  122. Attribute VB_Exposed = False
  123. Private Sub Command1_Click()
  124. On Error Resume Next
  125.  
  126. If Command1.Caption = "Serve" Then
  127. dsSocket1(0).LocalPort = 2000
  128. dsSocket1(0).Listen
  129. Text1 = "Now Serving Chat...."
  130. Command1.Caption = "Close"
  131. Timer1.Enabled = True
  132. Exit Sub
  133. End If
  134.  
  135.  
  136. If Command1.Caption = "Close" Then
  137. Timer1.Enabled = False
  138. For i = 0 To intMax
  139. dsSocket1(i).Close
  140. Next i
  141.  
  142. Text1 = Text1 & vbCrLf & "Serving Stopped."
  143. Command1.Caption = "Serve"
  144. Exit Sub
  145. End If
  146.  
  147. End Sub
  148.  
  149. Private Sub dsSocket1_Accept(Index As Integer, SocketID As Integer)
  150. On Error Resume Next
  151.  
  152. If Index = 0 Then
  153.  
  154.  intMax = intMax + 1
  155.  Load dsSocket1(intMax)  'load a new dssocket control
  156.  dsSocket1(intMax).TabStop = False
  157.  dsSocket1(intMax).Socket = SocketID
  158.  'accept the connection on the newly made control.
  159.    
  160. Text1 = Text1 & vbCrLf & "New User Joined" 'display status
  161.  
  162. 'now we gotta send the user list to the new user
  163. For i = 0 To List1.ListCount - 1
  164.  TimeOut 0.5
  165.  dsSocket1(intMax).Send = "_$u:" & List1.List(i)
  166.  TimeOut 0.1
  167.  Next i
  168.  
  169. End If
  170.  
  171. End Sub
  172.  
  173. Private Sub dsSocket1_Close(Index As Integer, ErrorCode As Integer, ErrorDesc As String)
  174. If intMax = 1 Then
  175. dsSocket1(1).Send = "ChatHOST:  well, no one is in the room except you.  you will not be able to send anymore text until we get someone else in here to see it.  you see, talking to yourself is the first sign of madness.  hehe"
  176. 'this just makes it so that if there is only one user
  177. 'left then they wont be able to chat.
  178. End If
  179.  
  180. End Sub
  181.  
  182. Private Sub dsSocket1_Exception(Index As Integer, ErrorCode As Integer, ErrorDesc As String)
  183. On Error Resume Next
  184. Text1 = Text1 & vbCrLf & "[" & Index & "]  " & ErrorCode & "   " & ErrorDesc
  185. 'display the error
  186.  
  187. End Sub
  188.  
  189. Private Sub dsSocket1_Receive(Index As Integer, ReceiveData As String)
  190. On Error Resume Next
  191.  
  192. 'new user
  193. If InStr(ReceiveData, "_$u:") Then
  194. thelen$ = Len(ReceiveData) - 4
  195. user$ = Right$(ReceiveData, thelen$)
  196. List1.AddItem user$
  197. Call List_NoDupes(List1)
  198. End If
  199.  
  200. 'user left
  201. If InStr(ReceiveData, "_$l:") Then
  202. thelen$ = Len(ReceiveData) - 4
  203. user$ = Right$(ReceiveData, thelen$)
  204. Call List_RemoveName(List1, user$)
  205. End If
  206.  
  207.  
  208. 'send the received data to each user in the chat.
  209. a = 0
  210. For i = 0 To intMax
  211. If a = intMax Then Exit For
  212. a = a + 1
  213. TimeOut 0.5
  214. dsSocket1(a).Send = ReceiveData
  215. Next i
  216. 'i put in a timeout of .5 because packets will get
  217. 'mixed up if you send them too fast.  you can change it
  218. 'but be warned that it could cause screwy data in your
  219. 'program.
  220.  
  221. Text1 = Text1 & vbCrLf & "data:>  [" & Index & "]   " & ReceiveData
  222. End Sub
  223.  
  224. Private Sub Form_Load()
  225. On Error Resume Next
  226.  
  227. 'this is for displaying your IP
  228. Text2 = dsSocket1(0).LocalDotAddr
  229.  
  230. End Sub
  231.  
  232. Private Sub Form_Unload(Cancel As Integer)
  233. On Error Resume Next
  234.  
  235. If Command1.Caption = "Close" Then
  236. For i = 0 To intMax
  237. dsSocket1(i).Send = "ChatHOST:  the server is now ending this chat session."
  238. dsSocket1(i).Close
  239. Next i
  240. End If
  241.  
  242. End
  243.  
  244. End Sub
  245.  
  246. Private Sub List1_DblClick()
  247.  
  248. 'this is pretty much useless.  heh.  i dont know why
  249. 'i even added it.  anywho, all it does is display the
  250. 'selected users name and their IP address in a message
  251. 'box.
  252.  
  253. T$ = "User:  " & List1.text
  254. T$ = T$ & vbCrLf
  255. T$ = T$ & "IP Address:  " & dsSocket1(List1.ListIndex).RemoteDotAddr
  256.  
  257. MsgBox T$, vbInformation, "Info on " & List1.text
  258.  
  259. End Sub
  260.  
  261. Private Sub Timer1_Timer()
  262. On Error Resume Next
  263.  
  264.  
  265. If Label3 = "3" Then
  266.  X = Str(Int(Rnd * 6)) + 1
  267.  If X = 7 Then X = 1
  268.  If X = 1 Then T$ = "did you know i say something exactly every 3 minutes?  weird huh?  hehe"
  269.  If X = 2 Then T$ = "this is a pretty cool multi-user chat example made by Jon Cromer"
  270.  If X = 3 Then T$ = "this example was written in under 30 minutes.  that's pretty good for the server and client and all the rem statements in here."
  271.  If X = 4 Then T$ = "if you're seeing this.... and this isn't called chat net  by Jon Cromer, then a lamer copied my form and said it was his.  make fun of the person who sent you this cause they cant code.  damn script kiddies."
  272.  If X = 5 Then T$ = "check out my website if ya got time.  http://www.pure-elite.com/senate/main.htm"
  273.  If X = 6 Then T$ = "im a bot created to spice up this chat  by Jon Cromer"
  274.  
  275.  For i = 0 To intMax
  276.  dsSocket1(i).Send = "ChatHOST:  " & T$
  277.  Next i
  278.  labe3 = "0"
  279.  Exit Sub
  280. End If
  281.  
  282. Label3 = Val(Label3) + 1
  283.  
  284.  
  285. End Sub
  286.